Visual Basic Source Code/Visual Basic Source Code.iso/vbsource/dde1/main.frm

Visual Basic Form | 1993-05-26 | 16.6 KB | 551 lines

VERSION 2.00
Begin Form frmMain
   BorderStyle     =   1  'Fixed Single
   Caption         =   "DDE Experimenter"
   FontTransparent =   0   'False
   Height          =   5745
   Left            =   930
   LinkMode        =   1  'Source
   LinkTopic       =   "System"
   ScaleHeight     =   5340
   ScaleWidth      =   6210
   Top             =   1125
   Width           =   6330
   Begin Frame Frames
      Caption         =   "Destination Data"
      Height          =   3015
      Index           =   2
      Left            =   120
      TabIndex        =   21
      Top             =   2280
      Width           =   6015
      Begin TextBox txtData
         Height          =   2160
         Left            =   120
         MultiLine       =   -1  'True
         ScrollBars      =   3  'Both
         TabIndex        =   22
         Text            =   "Text1"
         Top             =   720
         Width           =   5760
      End
      Begin OptionButton optDataType
         Caption         =   "Graphics"
         Height          =   255
         Index           =   1
         Left            =   1440
         TabIndex        =   14
         Top             =   360
         Width           =   1815
      End
      Begin OptionButton optDataType
         Caption         =   "Text"
         Height          =   255
         Index           =   0
         Left            =   120
         TabIndex        =   13
         Top             =   360
         Value           =   -1  'True
         Width           =   1095
      End
      Begin PictureBox picData
         AutoRedraw      =   -1  'True
         DrawWidth       =   2
         Height          =   2160
         Left            =   120
         ScaleHeight     =   2130
         ScaleWidth      =   5730
         TabIndex        =   23
         Top             =   720
         Visible         =   0   'False
         Width           =   5760
      End
   End
   Begin Frame Frames
      Caption         =   "Source Properties"
      Height          =   1440
      Index           =   1
      Left            =   4200
      TabIndex        =   20
      Top             =   720
      Width           =   1920
      Begin TextBox txtSourceTopic
         Height          =   285
         Left            =   120
         TabIndex        =   17
         Text            =   "System"
         Top             =   960
         Width           =   1695
      End
      Begin CheckBox chkSourceMode
         Caption         =   "&Source Enabled"
         Height          =   240
         Left            =   120
         TabIndex        =   15
         Top             =   360
         Value           =   1  'Checked
         Width           =   1680
      End
      Begin Label Labels
         Caption         =   "Source &Link Topic"
         Height          =   240
         Index           =   3
         Left            =   120
         TabIndex        =   16
         Top             =   720
         Width           =   1680
      End
   End
   Begin CommandButton cmdExit
      Caption         =   "E&xit"
      Height          =   480
      Left            =   4200
      TabIndex        =   18
      Top             =   120
      Width           =   1920
   End
   Begin Frame Frames
      Caption         =   "Destination Properties"
      Height          =   2160
      Index           =   0
      Left            =   120
      TabIndex        =   19
      Top             =   0
      Width           =   3960
      Begin ComboBox cboAppName
         Height          =   300
         Left            =   1200
         TabIndex        =   1
         Text            =   "ProgMan"
         Top             =   360
         Width           =   1215
      End
      Begin ComboBox cboTopic
         Height          =   300
         Left            =   720
         TabIndex        =   3
         Text            =   "ProgMan"
         Top             =   720
         Width           =   1695
      End
      Begin ComboBox cboItem
         Height          =   300
         Left            =   720
         TabIndex        =   5
         Top             =   1080
         Width           =   1695
      End
      Begin OptionButton optLinkMode
         Caption         =   "&Notify"
         Height          =   240
         Index           =   3
         Left            =   2640
         TabIndex        =   8
         Top             =   1200
         Width           =   960
      End
      Begin CommandButton cmdExecute
         Caption         =   "&Execute"
         Enabled         =   0   'False
         Height          =   480
         Left            =   2640
         TabIndex        =   12
         Top             =   1560
         Width           =   1080
      End
      Begin CommandButton cmdPoke
         Caption         =   "&Poke"
         Enabled         =   0   'False
         Height          =   480
         Left            =   1440
         TabIndex        =   11
         Top             =   1560
         Width           =   1080
      End
      Begin CommandButton cmdRequest
         Caption         =   "&Request"
         Enabled         =   0   'False
         Height          =   480
         Left            =   240
         TabIndex        =   10
         Top             =   1560
         Width           =   1080
      End
      Begin OptionButton optLinkMode
         Caption         =   "&Manual"
         Height          =   240
         Index           =   2
         Left            =   2640
         TabIndex        =   7
         Top             =   960
         Width           =   960
      End
      Begin OptionButton optLinkMode
         Caption         =   "A&utomatic"
         Height          =   240
         Index           =   1
         Left            =   2640
         TabIndex        =   6
         Top             =   720
         Width           =   1200
      End
      Begin CommandButton cmdConnect
         Caption         =   "&Connect"
         Height          =   480
         Left            =   2520
         TabIndex        =   9
         Top             =   240
         Width           =   1320
      End
      Begin Label Labels
         Caption         =   "Item"
         Height          =   255
         Index           =   2
         Left            =   120
         TabIndex        =   4
         Top             =   1080
         Width           =   615
      End
      Begin Label Labels
         Caption         =   "&Topic"
         Height          =   255
         Index           =   1
         Left            =   120
         TabIndex        =   2
         Top             =   720
         Width           =   615
      End
      Begin Label Labels
         Caption         =   "&Application"
         Height          =   255
         Index           =   0
         Left            =   120
         TabIndex        =   0
         Top             =   360
         Width           =   975
      End
   End
   Begin Label lblSysLink
      Height          =   375
      Left            =   4440
      TabIndex        =   25
      Top             =   5400
      Visible         =   0   'False
      Width           =   1455
   End
   Begin Label Topics
      Height          =   375
      Left            =   120
      TabIndex        =   24
      Top             =   5400
      Visible         =   0   'False
      Width           =   2175
   End
Option Explicit
Option Compare Text     ' Perform case-insensitive string comparisons
Dim TopicChangeFlag As Integer, appChangeFlag As Integer, Connected As Integer
Dim NotifyFlag As Integer
Const DEST_TEXT = 0, DEST_PIC = 1
Const MNU_COPY = 0, MNU_PASTE = 1, MNU_PASTELINK = 2
Sub cboAppName_Click ()
    If Connected Then cmdConnect.Value = True
    FillTopicList
End Sub
Sub cboAppName_LostFocus ()
    If appChangeFlag Then
    appChangeFlag = False
    If Connected Then cmdConnect.Value = True
    FillTopicList
    End If
End Sub
Sub cboItem_Change ()
On Error Resume Next
    picData.LinkItem = cboItem.Text
    txtData.LinkItem = cboItem.Text
End Sub
Sub cboItem_Click ()
    picData.LinkItem = cboItem.Text
    txtData.LinkItem = cboItem.Text
End Sub
Sub cboTopic_Change ()
    TopicChangeFlag = True
    CheckForSystemTopic
End Sub
Sub cboTopic_Click ()
    If Connected Then cmdConnect.Value = True
    CheckForSystemTopic
End Sub
Sub cboTopic_LostFocus ()
    If TopicChangeFlag Then
    TopicChangeFlag = False
    If Connected Then cmdConnect.Value = True
    CheckForSystemTopic
    End If
End Sub
Sub ChangeLinkTopic ()
End Sub
Sub CheckForSystemTopic ()
Dim i
    If cboTopic.Text = "SYSTEM" Or cboTopic.Text = "PROGMAN" Then
    FillSysItems
    optLinkMode(1).Enabled = False
    optLinkMode(3).Enabled = False
    optLinkMode(2).Value = True
    Else
    For i = 1 To 3
        optLinkMode(i).Enabled = True
    Next
    cboItem.Clear
    cboItem.Text = ""
    If cboAppName.Text = "WINWORD" Then
        cboItem.AddItem "\Doc"
        cboItem.Text = "\Doc"
        cboItem.Refresh
    End If
    End If
End Sub
Sub chkSourceMode_Click ()
    LinkMode = Abs(chkSourceMode.Value)
    txtSourceTopic.Enabled = chkSourceMode.Value
End Sub
Sub cmdConnect_Click ()
Dim clientLinkMode As Integer
    If Not Connected Then
    For clientLinkMode = 1 To 3
        If optLinkMode(clientLinkMode).Value Then Exit For
    Next
    picData.Picture = LoadPicture()
    txtData.Text = ""
    Select Case MakeConnection(clientLinkMode)
        Case 0
        ConnectState True
        Case NO_APP_RESPONDED
        If MsgBox("Hey! " & cboAppName.Text & " doesn't seem to be running. Should I start it?", MB_YESNO + MB_ICONQUESTION) = IDYES Then
            If StartApp((cboAppName.Text)) Then
            Select Case MakeConnection(clientLinkMode)
                Case 0
                ConnectState True
                Case NO_APP_RESPONDED
                MsgBox "Sorry, still can't connect."
            End Select
            End If
        End If
    End Select
    Else
    Disconnect txtData
    Disconnect picData
    ConnectState False
    End If
End Sub
Sub CmdExecute_Click ()
    ' Empty combo box on Execute form
    ' (This also implictly loads the form if it was unloaded).
    frmExecute.cboExecuteString.Clear
    ' Load sample execute strings appropriate to the source application
    Select Case cboAppName.Text
    Case "ProgMan"
        frmExecute.cboExecuteString.AddItem "[CreateGroup(DDE Group)]"
        frmExecute.cboExecuteString.AddItem "[AddItem(C:\VB\SAMPLES\DDE.EXE, Visual Basic DDE App)]"
        frmExecute.cboExecuteString.AddItem "[ShowGroup(DDE Group, 7)]"
    Case "Excel"
        frmExecute.cboExecuteString.AddItem "[SELECT(" & Chr(34) & "R1:R16384" & Chr(34) & ")]"
        frmExecute.cboExecuteString.AddItem "[NEW(2,2)]"
        frmExecute.cboExecuteString.AddItem "[GALLERY.3D.PIE(4)]"
        frmExecute.cboExecuteString.AddItem "[CLOSE()]"
    Case "WinWord"
        frmExecute.cboExecuteString.AddItem "[StartOfLine][EndOfLine 1]"
        frmExecute.cboExecuteString.AddItem "[InsertBookmark .Name = " & Chr(34) & "DDE1" & Chr(34) & "]"
        frmExecute.cboExecuteString.AddItem "[LineDown 1]"
    End Select
    frmExecute.Show MODAL
End Sub
Sub cmdExit_Click ()
    Unload frmMain
    End
End Sub
Sub cmdPoke_Click ()
On Error Resume Next
    txtData.LinkPoke
    If Err Then MsgBox Error
End Sub
Sub cmdRequest_Click ()
On Error Resume Next
    txtData.LinkRequest
    picData.LinkRequest
    NotifyFlag = False
End Sub
Sub ConnectState (State As Integer)
Dim i As Integer
    If State Then
    cmdConnect.Caption = "Disconnect"
    Else
    cmdConnect.Caption = "Connect"
    End If
    Connected = State
    cmdRequest.Enabled = State
    cmdPoke.Enabled = (optLinkMode(LINK_MANUAL).Value And State)
    cmdExecute.Enabled = State
    'cboAppName.Enabled = Not State
    'cboTopic.Enabled = Not State
End Sub
Function CreateLink (Ctl As Control, appname As String, topic As String, item As String, LinkType As Integer) As Integer
On Error Resume Next
    Ctl.LinkMode = NONE
    Ctl.LinkTopic = appname & "|" & topic
    Ctl.LinkItem = item
    Ctl.LinkMode = LinkType
    CreateLink = Err
    If Err = 0 And LinkType <> LINK_AUTOMATIC Then
    Ctl.LinkRequest
    End If
End Function
Sub Disconnect (Ctl As Control)
Dim tempTimeOutVal
On Error Resume Next    ' Disconnecting with ProgMan causes timeout error: just eat it and go on.
    tempTimeOutVal = Ctl.LinkTimeout
    Ctl.LinkTimeout = 1
    Ctl.LinkMode = NONE
    Ctl.LinkTimeout = tempTimeOutVal
End Sub
Sub FillList (cbo As Control, lbl As Control)
Dim i As Integer, lasti As Integer
    Do
    i = i + 1
    lasti = i
    i = InStr(lasti, lbl.Caption, Chr(9))
    If i = 0 Then
        cbo.AddItem Mid(lbl.Caption, lasti)
        Exit Do
    Else
        cbo.AddItem Mid(lbl.Caption, lasti, i - lasti)
    End If
    Loop
End Sub
Sub FillSysItems ()
    cboItem.Clear
    Screen.MousePointer = HOURGLASS
    lblSysLink.LinkMode = NONE
    lblSysLink.LinkTopic = cboAppName.Text & "|" & "System"
    lblSysLink.LinkItem = "SysItems"
    On Error Resume Next
    lblSysLink.LinkMode = LINK_MANUAL
    If Err = 0 Then
    lblSysLink.LinkRequest
    FillList cboItem, lblSysLink
    cboItem.Text = "SysItems"
    End If
    cboItem.Refresh
    Screen.MousePointer = DEFAULT
End Sub
Sub FillTopicList ()
    cboTopic.Clear
    cboTopic.Text = ""
    If cboAppName.Text = "ProgMan" Then
    cboTopic.Text = "ProgMan"
    Else
    Screen.MousePointer = HOURGLASS
    lblSysLink.LinkMode = NONE
    lblSysLink.LinkTopic = cboAppName.Text & "|" & "System"
    lblSysLink.LinkItem = "Topics"
    On Error Resume Next
    lblSysLink.LinkMode = LINK_MANUAL
    If Err Then
        cboTopic.AddItem "System"
    Else
        lblSysLink.LinkRequest
        FillList cboTopic, lblSysLink
        cboTopic.Text = "System"
    End If
    Screen.MousePointer = DEFAULT
    End If
    cboTopic.Refresh
End Sub
Sub Form_Load ()
    cboAppName.AddItem "ProgMan"
    cboAppName.AddItem "DDE"
    cboAppName.AddItem "Excel"
    cboAppName.AddItem "WinWord"
    cboAppName.AddItem "FoxPro"
    cboAppName.AddItem "Access"
    cboAppName.AddItem "Project"
    LinkTopic = txtSourceTopic.Text
    Topics.Caption = "Topics" & Chr(9) & "picData" & Chr(9) & "txtData" & Chr(13) & Chr(10)
End Sub
Sub Form_Unload (Cancel As Integer)
    Disconnect txtData
    Disconnect picData
End Sub
Function MakeConnection (clientLinkMode As Integer) As Integer
Dim ConnectTxt As Integer, ConnectPic As Integer
    ConnectPic = CreateLink(picData, (cboAppName.Text), (cboTopic.Text), (cboItem.Text), clientLinkMode)
    ConnectTxt = CreateLink(txtData, (cboAppName.Text), (cboTopic.Text), (cboItem.Text), clientLinkMode)
    If ConnectPic = NO_APP_RESPONDED And ConnectTxt = NO_APP_RESPONDED Then
    MakeConnection = NO_APP_RESPONDED
    ElseIf ConnectTxt = 0 Then
    MakeConnection = 0
    optDataType(DEST_TEXT).Value = True
    ElseIf ConnectPic = 0 Then
    MakeConnection = 0
    optDataType(DEST_PIC).Value = True
    Else
    MakeConnection = ConnectPic
    End If
End Function
Sub optDataType_Click (Index As Integer)
    If Index = DEST_TEXT Then
    txtData.Visible = True
    picData.Visible = False
    ElseIf Index = DEST_PIC Then
    txtData.Visible = False
    picData.Visible = True
    End If
End Sub
Sub optLinkMode_Click (Index As Integer)
    If Connected Then
    cmdConnect.Value = True
    cmdConnect.Value = True
    End If
End Sub
Sub picData_LinkClose ()
    ConnectState False
End Sub
Sub picData_LinkNotify ()
    If Not NotifyFlag Then
    MsgBox "New data is available from the DDE Source.  Choose Request to update."
    NotifyFlag = True
    End If
End Sub
Sub picData_MouseDown (Button As Integer, Shift As Integer, X As Single, Y As Single)
    If Button And 1 Then
    PSet (X, Y)
    Else
    picData.ForeColor = QBColor(Rnd * 16)
    End If
End Sub
Sub picData_MouseMove (Button As Integer, Shift As Integer, X As Single, Y As Single)
    If Button And 1 Then picData.Line -(X, Y)
End Sub
Sub picData_MouseUp (Button As Integer, Shift As Integer, X As Single, Y As Single)
    If Button And 1 Then
    picData.LinkSend
    End If
End Sub
Function StartApp (appname As String) As Integer
On Error Resume Next
    StartApp = (Shell(appname) > 31)
    If Err Then MsgBox "Couldn't start " & appname
    StartApp = 0
End Function
Sub txtData_LinkClose ()
    ConnectState False
End Sub
Sub txtData_LinkNotify ()
    If Not NotifyFlag Then
    MsgBox "New data is available from the DDE Source.  Choose Request to update."
    NotifyFlag = True
    End If
End Sub
Sub txtSourceTopic_Change ()
    LinkTopic = txtSourceTopic.Text
End Sub